#ifndef RUNTIME_H_INCLUDED
#define RUNTIME_H_INCLUDED

#endif // RUNTIME_H_INCLUDED



#define caml_white (0 << 8)
#define caml_gray  (1 << 8)
#define caml_blue  (2 << 8)
#define caml_black (3 << 8)


#define closure_tag 247
#define infix_tag 249
#define string_tag 252
#define double_tag 253
#define double_array_tag 254

#define get_char(x, i) (((unsigned char *)((get_field(x,0))))[i])
#define get_tag(val) (((unsigned char *) (get_field(val,-1))) [0])
#define get_size(val) (((unsigned char *) (get_field(val,-1)))  [1])

#define make_value(x)     (((int16_t)(x) << 1) + 1)
//#define get_value(x)        ((int16_t)(x) << 1)
#define Primitive(n) (/*(c_primitive)(caml_prim_table.contents[n])*/)
#define get_value(x)        (((int16_t)(x)) >> 1)
#define store_double_val(v,d) (* (double *)(v) = (d))

#define store_double_field(v,i,d) do{ \
  int caml__temp_i = (i); \
  double caml__temp_d = (d); \
  store_double_val(((double *) (v) + caml__temp_i), caml__temp_d); \
}while(0)

#define code_val(val) (((int16_t *) (val)) [0]);
//#define Code_val(val) (((code_t *) (val)) [0]);

#define ATOM_VALUE 1

#define is_block(x) ((x & 0x0001)==0 )

int16_t * heap = NULL;
int heap_size = 5000;
int16_t * heap_start;
int16_t * heap_limit ;
int16_t * heap_ptr;
int16_t * atom;
int16_t atom_content[1];

int16_t make_header(int size , int tag)
{
    return (((size) << 8)   +  (tag)    );
}

void init_heap()
{
    int16_t i;
    int16_t * memory =(int16_t *) malloc( sizeof(int16_t)* heap_size );
    heap = memory;
    atom_content[0] = make_header(0, 0);
    atom = atom_content;
    //*heap = ATOM_VALUE;
    heap_start = heap;
    heap_ptr = heap;
    heap_limit = memory + (heap_size/2);
    for(i = 0 ; i < initial_heap_size ; i ++){
        *heap_ptr++ = initial_heap[i];
        printf("%X ",initial_heap[i]);
    }
}

void print_header(int16_t i)
{
    printf("size : %d \n",i>>10);
    printf("tag : %d \n",i&0xFF);
}

int16_t get_code_val(int16_t block)
{
    return (*((int16_t *) ((heap_start +(block >>1))+1))>>1);
}

int16_t get_address( int16_t block)
{
    return (int16_t) (heap_start + (block >> 1));
}

int16_t * get_field(int16_t block,int i)
{
    if((block & 0x0001)!=0 )
    {
        printf("error : get_field on value \n");
        exit(5);
    }
    else
    {
        int16_t tmp = block >> 1;
        int16_t * addr = (heap_start + tmp);
        //print_header(*addr);
        //printf("getfield addr = %d %d\n",addr,tmp);
        return (addr+i+1); // + 1 pour ignorer le header
    }

}


int16_t alloc_block(int16_t ** result,int size, int tag)
{
    if( heap_ptr > heap_limit)
    {
        // start GC
        printf("out of memory :( no gc yet \n");
        exit(10);
    }

    *heap_ptr = make_header(size , tag);
    int16_t r = (heap_ptr - heap_start) << 1;
    heap_ptr += size + 1;
    printf("alloc new block: size = %d, addr = %d\n", size, r);
    return  r;
}



//#define Field(x, i) (((int16_t *)(x)) [i])

#define Field(x, i) (*(get_field(x,i)))

// Fonctions Floats

/*
#define Store_double_field(v,i,d) do{ \
  mlsize_t caml__temp_i = (i); \
  double caml__temp_d = (d); \
  Store_double_val((value)((double *) (v) + caml__temp_i), caml__temp_d); \
}while(0)

#define Store_double_val(v,d) (* (double *)(v) = (d))

*/

/*
#define Alloc_small(result, wosize, tag) do{    CAMLassert ((wosize) >= 1); \
                                          CAMLassert ((tag_t) (tag) < 256); \
                                 CAMLassert ((wosize) <= Max_young_wosize); \
  caml_young_ptr -= Bhsize_wosize (wosize);                                 \
  if (caml_young_ptr < caml_young_limit){                                   \
    caml_young_ptr += Bhsize_wosize (wosize);                               \
    Setup_for_gc;                                                           \
    caml_minor_collection ();                                               \
    Restore_after_gc;                                                       \
    caml_young_ptr -= Bhsize_wosize (wosize);                               \
  }                                                                         \
  Hd_hp (caml_young_ptr) = Make_header ((wosize), (tag), Caml_black);       \
  (result) = Val_hp (caml_young_ptr);                                       \
  DEBUG_clear ((result), (wosize));                                         \
}while(0)

#define Hd_hp(hp) (* ((header_t *) (hp)))
#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1))
#define Code_val(val) (((code_t *) (val)) [0])     // Also an l-value.
#define Whsize_wosize(sz) ((sz) + 1)
#define Wosize_whsize(sz) ((sz) - 1)
#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1)
#define Bsize_wsize(sz) ((sz) * sizeof (value))
#define Wsize_bsize(sz) ((sz) / sizeof (value))
#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz)))

void caml_set_minor_heap_size (asize_t size)
{
  char *new_heap;
  void *new_heap_base;

  Assert (size >= Minor_heap_min);
  Assert (size <= Minor_heap_max);
  Assert (size % sizeof (value) == 0);
  if (caml_young_ptr != caml_young_end) caml_minor_collection ();
                                    Assert (caml_young_ptr == caml_young_end);
  new_heap = caml_aligned_malloc(size, 0, &new_heap_base);
  if (new_heap == NULL) caml_raise_out_of_memory();
  if (caml_page_table_add(In_young, new_heap, new_heap + size) != 0)
    caml_raise_out_of_memory();

  if (caml_young_start != NULL){
    caml_page_table_remove(In_young, caml_young_start, caml_young_end);
    free (caml_young_base);
  }
  caml_young_base = new_heap_base;
  caml_young_start = new_heap;
  caml_young_end = new_heap + size;
  caml_young_limit = caml_young_start;
  caml_young_ptr = caml_young_end;
  caml_minor_heap_size = size;

  reset_table (&caml_ref_table);
  reset_table (&caml_weak_ref_table);
}

void caml_init_gc (uintnat minor_size, uintnat major_size,
                   uintnat major_incr, uintnat percent_fr,
                   uintnat percent_m)
{
  uintnat major_heap_size = Bsize_wsize (norm_heapincr (major_size));

  if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_heap_size)){
    caml_fatal_error ("OCaml runtime error: cannot initialize page table\n");
  }
  caml_set_minor_heap_size (Bsize_wsize (norm_minsize (minor_size)));
  caml_major_heap_increment = Bsize_wsize (norm_heapincr (major_incr));
  caml_percent_free = norm_pfree (percent_fr);
  caml_percent_max = norm_pmax (percent_m);
  caml_init_major_heap (major_heap_size);
  caml_gc_message (0x20, "Initial minor heap size: %luk bytes\n",
                   caml_minor_heap_size / 1024);
  caml_gc_message (0x20, "Initial major heap size: %luk bytes\n",
                   major_heap_size / 1024);
  caml_gc_message (0x20, "Initial space overhead: %lu%%\n", caml_percent_free);
  caml_gc_message (0x20, "Initial max overhead: %lu%%\n", caml_percent_max);
  caml_gc_message (0x20, "Initial heap increment: %luk bytes\n",
                   caml_major_heap_increment / 1024);
  caml_gc_message (0x20, "Initial allocation policy: %d\n",
                   caml_allocation_policy);
}

char *caml_aligned_malloc (asize_t size, int modulo, void **block)
{
  char *raw_mem;
  uintnat aligned_mem;
                                                  Assert (modulo < Page_size);
  raw_mem = (char *) malloc (size + Page_size);
  if (raw_mem == NULL) return NULL;
  *block = raw_mem;
  raw_mem += modulo;                //Address to be aligned
  aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size);
#ifdef DEBUG
  {
    uintnat *p;
    uintnat *p0 = (void *) *block,
            *p1 = (void *) (aligned_mem - modulo),
            *p2 = (void *) (aligned_mem - modulo + size),
            *p3 = (void *) ((char *) *block + size + Page_size);

    for (p = p0; p < p1; p++) *p = Debug_filler_align;
    for (p = p1; p < p2; p++) *p = Debug_uninit_align;
    for (p = p2; p < p3; p++) *p = Debug_filler_align;
  }
#endif
  return (char *) (aligned_mem - modulo);
}

static c_primitive lookup_primitive(char * name)
{
  int i;
  void * res;

  for (i = 0; caml_names_of_builtin_cprim[i] != NULL; i++) {
    if (strcmp(name, caml_names_of_builtin_cprim[i]) == 0)
      return caml_builtin_cprim[i];
  }
  for (i = 0; i < shared_libs.size; i++) {
    res = caml_dlsym(shared_libs.contents[i], name);
    if (res != NULL) return (c_primitive) res;
  }
  return NULL;
}
*/

/*
#define Alloc_small(result, wosize, tag) do{    CAMLassert ((wosize) >= 1); \
                                          CAMLassert ((tag_t) (tag) < 256); \
                                 CAMLassert ((wosize) <= Max_young_wosize); \
  caml_young_ptr -= Bhsize_wosize (wosize);                                 \
  if (caml_young_ptr < caml_young_limit){                                   \
    caml_young_ptr += Bhsize_wosize (wosize);                               \
    Setup_for_gc;                                                           \
    caml_minor_collection ();                                               \
    Restore_after_gc;                                                       \
    caml_young_ptr -= Bhsize_wosize (wosize);                               \
  }                                                                         \
  Hd_hp (caml_young_ptr) = Make_header ((wosize), (tag), Caml_black);       \
  (result) = Val_hp (caml_young_ptr);                                       \
  DEBUG_clear ((result), (wosize));                                         \
}while(0)

#define Make_header(wosize, tag, color)                                       \
      (                                 \
       ((header_t) (((header_t) (wosize) << 10)                               \
                    + (color)                                                 \
                    + (tag_t) (tag)))                                         \
      )

static intnat compare_val(value v1, value v2, int total)
{
  struct compare_item * sp;
  tag_t t1, t2;

  sp = compare_stack;
  while (1) {
    if (v1 == v2 && total) goto next_item;
    if (Is_long(v1)) {
      if (v1 == v2) goto next_item;
      if (Is_long(v2))
        return Long_val(v1) - Long_val(v2);
      // Subtraction above cannot overflow and cannot result in UNORDERED
      if (Is_in_value_area(v2)) {
        switch (Tag_val(v2)) {
        case Forward_tag:
          v2 = Forward_val(v2);
          continue;
        case Custom_tag: {
          int res;
          int (*compare)(value v1, value v2) = Custom_ops_val(v2)->compare_ext;
          if (compare == NULL) break;  // for backward compatibility
          caml_compare_unordered = 0;
          res = compare(v1, v2);
          if (caml_compare_unordered && !total) return UNORDERED;
          if (res != 0) return res;
          goto next_item;
        }
        default: ;//fallthrough
        }
      }
      return LESS;                // v1 long < v2 block
    }
    if (Is_long(v2)) {
      if (Is_in_value_area(v1)) {
        switch (Tag_val(v1)) {
        case Forward_tag:
          v1 = Forward_val(v1);
          continue;
        case Custom_tag: {
          int res;
          int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare_ext;
          if (compare == NULL) break;  // for backward compatibility
          caml_compare_unordered = 0;
          res = compare(v1, v2);
          if (caml_compare_unordered && !total) return UNORDERED;
          if (res != 0) return res;
          goto next_item;
        }
        default: ;//*fallthrough
        }
      }
      return GREATER;            //* v1 block > v2 long
    }
    //* If one of the objects is outside the heap (but is not an atom),
     //  use address comparison. Since both addresses are 2-aligned,
       //shift lsb off to avoid overflow in subtraction.
    if (! Is_in_value_area(v1) || ! Is_in_value_area(v2)) {
      if (v1 == v2) goto next_item;
      return (v1 >> 1) - (v2 >> 1);
      //* Subtraction above cannot result in UNORDERED
    }
    t1 = Tag_val(v1);
    t2 = Tag_val(v2);
    if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; }
    if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; }
    if (t1 != t2) return (intnat)t1 - (intnat)t2;
    switch(t1) {
    case String_tag: {
      mlsize_t len1, len2;
      int res;
      if (v1 == v2) break;
      len1 = caml_string_length(v1);
      len2 = caml_string_length(v2);
      res = memcmp(String_val(v1), String_val(v2), len1 <= len2 ? len1 : len2);
      if (res < 0) return LESS;
      if (res > 0) return GREATER;
      if (len1 != len2) return len1 - len2;
      break;
    }
    case Double_tag: {
      double d1 = Double_val(v1);
      double d2 = Double_val(v2);
      if (d1 < d2) return LESS;
      if (d1 > d2) return GREATER;
      if (d1 != d2) {
        if (! total) return UNORDERED;
        //* One or both of d1 and d2 is NaN.  Order according to the
         //  convention NaN = NaN and NaN < f for all other floats f.
        if (d1 == d1) return GREATER; // d1 is not NaN, d2 is NaN
        if (d2 == d2) return LESS;    //* d2 is not NaN, d1 is NaN
        //* d1 and d2 are both NaN, thus equal: continue comparison
      }
      break;
    }
    case Double_array_tag: {
      mlsize_t sz1 = Wosize_val(v1) / Double_wosize;
      mlsize_t sz2 = Wosize_val(v2) / Double_wosize;
      mlsize_t i;
      if (sz1 != sz2) return sz1 - sz2;
      for (i = 0; i < sz1; i++) {
        double d1 = Double_field(v1, i);
        double d2 = Double_field(v2, i);
        if (d1 < d2) return LESS;
        if (d1 > d2) return GREATER;
        if (d1 != d2) {
          if (! total) return UNORDERED;
         // /* See comment for Double_tag case
          if (d1 == d1) return GREATER;
          if (d2 == d2) return LESS;
        }
      }
      break;
    }
    case Abstract_tag:
      compare_free_stack();
      caml_invalid_argument("equal: abstract value");
    case Closure_tag:
    case Infix_tag:
      compare_free_stack();
      caml_invalid_argument("equal: functional value");
    case Object_tag: {
      intnat oid1 = Oid_val(v1);
      intnat oid2 = Oid_val(v2);
      if (oid1 != oid2) return oid1 - oid2;
      break;
    }
    case Custom_tag: {
      int res;
      int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare;
      //* Hardening against comparisons between different types
      if (compare != Custom_ops_val(v2)->compare) {
        return strcmp(Custom_ops_val(v1)->identifier,
                      Custom_ops_val(v2)->identifier) < 0
               ? LESS : GREATER;
      }
      if (compare == NULL) {
        compare_free_stack();
        caml_invalid_argument("equal: abstract value");
      }
      caml_compare_unordered = 0;
      res = compare(v1, v2);
      if (caml_compare_unordered && !total) return UNORDERED;
      if (res != 0) return res;
      break;
    }
    default: {
      mlsize_t sz1 = Wosize_val(v1);
      mlsize_t sz2 = Wosize_val(v2);
      //* Compare sizes first for speed
      if (sz1 != sz2) return sz1 - sz2;
      if (sz1 == 0) break;
      //* Remember that we still have to compare fields 1 ... sz - 1
      if (sz1 > 1) {
        sp++;
        if (sp >= compare_stack_limit) sp = compare_resize_stack(sp);
        sp->v1 = &Field(v1, 1);
        sp->v2 = &Field(v2, 1);
        sp->count = sz1 - 1;
      }
      //* Continue comparison with first field
      v1 = Field(v1, 0);
      v2 = Field(v2, 0);
      continue;
    }
    }
  next_item:
    //* Pop one more item to compare, if any
    if (sp == compare_stack) return EQUAL; //* we're done
    v1 = *((sp->v1)++);
    v2 = *((sp->v2)++);
    if (--(sp->count) == 0) sp--;
  }
}

CAMLprim value caml_compare(value v1, value v2)
{
  intnat res = compare_val(v1, v2, 1);
  //* Free stack if needed
  if (compare_stack != compare_stack_init) compare_free_stack();
  if (res < 0)
    return Val_int(LESS);
  else if (res > 0)
    return Val_int(GREATER);
  else
    return Val_int(EQUAL);
}

CAMLprim value caml_equal(value v1, value v2)
{
  intnat res = compare_val(v1, v2, 0);
  if (compare_stack != compare_stack_init) compare_free_stack();
  return Val_int(res == 0);
}

CAMLprim value caml_notequal(value v1, value v2)
{
  intnat res = compare_val(v1, v2, 0);
  if (compare_stack != compare_stack_init) compare_free_stack();
  return Val_int(res != 0);
}

CAMLprim value caml_lessthan(value v1, value v2)
{
  intnat res = compare_val(v1, v2, 0);
  if (compare_stack != compare_stack_init) compare_free_stack();
  return Val_int(res < 0 && res != UNORDERED);
}

CAMLprim value caml_lessequal(value v1, value v2)
{
  intnat res = compare_val(v1, v2, 0);
  if (compare_stack != compare_stack_init) compare_free_stack();
  return Val_int(res <= 0 && res != UNORDERED);
}

CAMLprim value caml_greaterthan(value v1, value v2)
{
  intnat res = compare_val(v1, v2, 0);
  if (compare_stack != compare_stack_init) compare_free_stack();
  return Val_int(res > 0);
}

CAMLprim value caml_greaterequal(value v1, value v2)
{
  intnat res = compare_val(v1, v2, 0);
  if (compare_stack != compare_stack_init) compare_free_stack();
  return Val_int(res >= 0);
}
*/
